home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_rulc.pl < prev    next >
Encoding:
Perl Script  |  1994-06-23  |  8.5 KB  |  275 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_rulc.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_rulc" perl package.  It defines
  8. ##    routines to handle the RulingCatalog via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_rulc;
  31.  
  32. ##-----------------------------------------------##
  33. ## Add RulingCatalog function to %MIFToken array ##
  34. ##-----------------------------------------------##
  35. $mif'MIFToken{'RulingCatalog'} = 'RulingCatalog';
  36.  
  37. ##----------------------------------##
  38. ## RulingCatalog associative arrays ##
  39. ##----------------------------------##
  40. %RulingPenWidth    = ();
  41. %RulingGap    = ();
  42. %RulingColor    = ();    # Frame 4.x
  43. %RulingSeparation = ();    # Frame 3.x
  44. %RulingPen    = ();
  45. %RulingLines    = ();
  46.  
  47. ##-----------------------------------------##
  48. ## Variables for current Ruling definition ##
  49. ##-----------------------------------------##
  50. $rulc_Tag    = "";
  51. $rulc_PenWidth    = "";
  52. $rulc_Gap    = "";
  53. $rulc_Color    = "";
  54. $rulc_Separation = "";
  55. $rulc_Pen    = "";
  56. $rulc_Lines    = "";
  57.  
  58. ##------------------------##
  59. ## Import 'mif' variables ##
  60. ##------------------------##
  61. $MStore        = $mif'MStore;
  62. $MOpen        = $mif'MOpen;
  63. $MClose        = $mif'MClose;
  64. $MLine        = $mif'MLine;
  65. $mso        = $mif'mso;
  66. $msc        = $mif'msc;
  67. $stb        = $mif'stb;
  68. $ste        = $mif'ste;
  69. $como        = $mif'como;
  70.  
  71.                 ##---------------##
  72.                 ## Main Routines ##
  73.                 ##---------------##
  74. ##---------------------------------------------------------------------------
  75. ##    MIFwrite_rulc() outputs the RulingCatalog as defined by the
  76. ##    associative arrays.
  77. ##
  78. ##    Usage:
  79. ##        &'MIFwrite_rulc(FILEHANDLE);
  80. ##
  81. sub main'MIFwrite_rulc {
  82.     local($handle, $l) = @_;
  83.     local($i0, $i1, $i2) = (' ' x $l, ' ' x (1+$l), ' ' x (2+$l));
  84.  
  85.     print $handle $i0, $mso, 'RulingCatalog', "\n";
  86.     foreach (sort keys %RulingPenWidth) {
  87.     print $handle $i1, $mso, "Ruling\n";
  88.     print $handle $i2, $mso, 'RulingTag ', $stb, $_, $ste, $msc, "\n";
  89.     print $handle $i2, $mso, 'RulingPenWidth ', $RulingPenWidth{$_}, $msc,
  90.                "\n"
  91.         if $RulingPenWidth{$_} ne "";
  92.     print $handle $i2, $mso, 'RulingGap ', $RulingGap{$_}, $msc,
  93.                "\n"
  94.         if $RulingGap{$_} ne "";
  95.     print $handle $i2, $mso, 'RulingSeparation ', $RulingSeparation{$_},
  96.                $msc, "\n"
  97.         if $RulingSeparation{$_} ne "";
  98.     print $handle $i2, $mso, 'RulingColor ', $stb, $RulingColor{$_}, $ste,
  99.                $msc, "\n"
  100.         if $RulingColor{$_} ne "";
  101.     print $handle $i2, $mso, 'RulingPen ', $RulingPen{$_}, $msc,
  102.                "\n"
  103.         if $RulingPen{$_} ne "";
  104.     print $handle $i2, $mso, 'RulingLines ', $RulingLines{$_}, $msc,
  105.                "\n"
  106.         if $RulingLines{$_} ne "";
  107.     print $handle $i1, $msc, " $como end of Ruling\n";
  108.     }
  109.     print $handle $i0, $msc, " $como end of RulingCatalog\n";
  110. }
  111. ##---------------------------------------------------------------------------##
  112. ##    MIFget_ruling_data() is a convienence routine that returns
  113. ##    the data associated with the ruling $ruling.
  114. ##
  115. ##    Usage:
  116. ##        ($penwidth, $gap, $color, $sep, $pen, $lines) =
  117. ##        &'MIFget_ruling_data($ruling);
  118. ##
  119. sub main'MIFget_ruling_data {
  120.     local($ruling) = @_;
  121.     ($RulingPenWidth{$ruling},
  122.      $RulingGap{$ruling}, 
  123.      $RulingColor{$ruling}, 
  124.      $RulingSeparation{$ruling}, 
  125.      $RulingPen{$ruling}, 
  126.      $RulingLines{$ruling});
  127. }
  128. ##---------------------------------------------------------------------------##
  129. ##      MIFget_rulings() returns a sorted array of all ruling names
  130. ##    defined in the ruling catalog.
  131. ##
  132. ##      Usage:
  133. ##          @rulings = &'MIFget_rulings();
  134. ##
  135. sub main'MIFget_rulings {
  136.     return sort keys %RulingPenWidth;
  137. }
  138. ##---------------------------------------------------------------------------##
  139. ##    MIFreset_rulc() resets the associative arrays for the ruling
  140. ##    catalog.
  141. ##
  142. ##    Usage:
  143. ##        &'MIFreset_rulc();
  144. ##
  145. sub main'MIFreset_rulc {
  146.     undef %RulingPenWidth;
  147.     undef %RulingGap;
  148.     undef %RulingColor;
  149.     undef %RulingSeparation;
  150.     undef %RulingPen;
  151.     undef %RulingLines;
  152. }
  153. ##---------------------------------------------------------------------------##
  154.                 ##--------------##
  155.                 ## Mif Routines ##
  156.                 ##--------------##
  157. ##---------------------------------------------------------------------------##
  158. ##    The routines definded below are all registered in the %MIFToken         ##
  159. ##    array for use in the read_mif() routine.  There purpose is to         ##
  160. ##    store the information contained in the ruling catalog.             ##
  161. ##---------------------------------------------------------------------------##
  162.  
  163. ##---------------------------------------------------------------------------
  164. ##    RulingCatalog() is the token routine for 'RulingCatalog'.
  165. ##    It sets/restores token routines depending upon mode.
  166. ##
  167. sub mif'RulingCatalog {
  168.     local($token, $mode, *data) = @_;
  169.     if ($mode == $MOpen) {
  170.     ($_fast, $_noidata) = ($mif'fast, $mif'no_import_data);
  171.     ($mif'fast, $mif'no_import_data) = (1, 1);
  172.     @_rulc_orgfunc = @mif'MIFToken{
  173.                 'Ruling',
  174.                 'RulingTag',
  175.                 'RulingPenWidth',
  176.                 'RulingGap',
  177.                 'RulingColor',
  178.                 'RulingSeparation',
  179.                 'RulingPen',
  180.                 'RulingLines'
  181.             };
  182.     @mif'MIFToken{
  183.         'Ruling',
  184.         'RulingTag',
  185.         'RulingPenWidth',
  186.         'RulingGap',
  187.         'RulingColor',
  188.         'RulingSeparation',
  189.         'RulingPen',
  190.         'RulingLines'
  191.     } = (
  192.         "mif_rulc'Ruling",
  193.         "mif_rulc'RulingTag",
  194.         "mif_rulc'RulingPenWidth",
  195.         "mif_rulc'RulingGap",
  196.         "mif_rulc'RulingColor",
  197.         "mif_rulc'RulingSeparation",
  198.         "mif_rulc'RulingPen",
  199.         "mif_rulc'RulingLines"
  200.     );
  201.     } elsif ($mode == $MClose) {
  202.     @mif'MIFToken{
  203.         'Ruling',
  204.         'RulingTag',
  205.         'RulingPenWidth',
  206.         'RulingGap',
  207.         'RulingColor',
  208.         'RulingSeparation',
  209.         'RulingPen',
  210.         'RulingLines'
  211.     } = @_rulc_orgfunc;
  212.         ($mif'fast, $mif'no_import_data) = ($_fast, $_noidata);
  213.     }
  214. }
  215. ##---------------------------------------------------------------------------
  216. sub Ruling {
  217.     local($token, $mode, *data) = @_;
  218.  
  219.     if ($mode == $MOpen) {
  220.     $rulc_Tag = "";
  221.     $rulc_PenWidth = "";
  222.     $rulc_Gap = "";
  223.     $rulc_Color = "";
  224.     $rulc_Separation = "";
  225.     $rulc_Pen = "";
  226.     $rulc_Lines = "";
  227.     } elsif ($mode == $MClose) {
  228.     $RulingPenWidth{$rulc_Tag} = $rulc_PenWidth;
  229.     $RulingGap{$rulc_Tag} = $rulc_Gap;
  230.     $RulingColor{$rulc_Tag} = $rulc_Color;
  231.     $RulingSeparation{$rulc_Tag} = $rulc_Separation;
  232.     $RulingPen{$rulc_Tag} = $rulc_Pen;
  233.     $RulingLines{$rulc_Tag} = $rulc_Lines;
  234.     } else {
  235.     warn "Unexpected mode, $mode, passed to Ruling routine\n";
  236.     }
  237. }
  238. ##---------------------------------------------------------------------------
  239. sub RulingTag {
  240.     local($token, $mode, *data) = @_;
  241.     ($rulc_Tag) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  242. }
  243. ##---------------------------------------------------------------------------
  244. sub RulingColor {
  245.     local($token, $mode, *data) = @_;
  246.     ($rulc_Color) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  247. }
  248. ##---------------------------------------------------------------------------
  249. sub RulingPenWidth {
  250.     local($token, $mode, *data) = @_;
  251.     ($rulc_PenWidth) = $data =~ /^\s*(.*)$/o;
  252. }
  253. ##---------------------------------------------------------------------------
  254. sub RulingGap {
  255.     local($token, $mode, *data) = @_;
  256.     ($rulc_Gap) = $data =~ /^\s*(.*)$/o;
  257. }
  258. ##---------------------------------------------------------------------------
  259. sub RulingPen {
  260.     local($token, $mode, *data) = @_;
  261.     ($rulc_Pen) = $data =~ /^\s*(.*)$/o;
  262. }
  263. ##---------------------------------------------------------------------------
  264. sub RulingLines {
  265.     local($token, $mode, *data) = @_;
  266.     ($rulc_Lines) = $data =~ /^\s*(.*)$/o;
  267. }
  268. ##---------------------------------------------------------------------------
  269. sub RulingSeparation {
  270.     local($token, $mode, *data) = @_;
  271.     ($rulc_Separation) = $data =~ /^\s*(.*)$/o;
  272. }
  273. ##---------------------------------------------------------------------------
  274. 1;
  275.